Billiards and Tilts Analysis Notebook

0.1 Load all of the throw data

# load omnibus dataframe
omnibus_df <- read_delim("../data/processed/omnibus/omnibus_raw.csv",
  delim = ",",
  col_types = cols(
    .default = col_double(),
    type = col_factor(),
    ppid = col_factor(),
    exp_label = col_factor(),
    experiment = col_factor(),
    hand = col_factor(),
    camera_tilt = col_factor(),
    surface_tilt = col_factor(),
    target = col_factor(),
    test_type = col_factor(),
    prior_anim = col_factor(),
    baseline_block = col_factor(),
    task_type = col_factor(),
    surface = col_factor(),
    anim_type = col_factor()
  )
) %>%
  filter(block_num > 4) # filter out practice blocks

1 Visualizing data (univariate)

Vectors representing the throw velocity (trace 0) and the velocity applied to the ball (trace 1). The y dimention of the throw is essentially ignored (in reality there is a slight tilt added to account for the tilt of the surface).

test_ppt <- 3

test_df <- omnibus_df %>% filter(ppid == test_ppt)


trial <- 250
trial_df <- filter(test_df, trial_num == trial)

x <- trial_df$flick_velocity_x 
y <- trial_df$flick_velocity_y
z <- trial_df$flick_velocity_z

x2 <- trial_df$flick_direction_x * -1
y2 <- trial_df$flick_direction_y * -1
z2 <- trial_df$flick_direction_z * -1

# plot both
p <- plot_ly(x = c(0, x), y = c(0, y), z = c(0, z), type = "scatter3d", mode = "lines") %>%
  add_trace(x = c(0, x2), y = c(0, y2), z = c(0, z2), type = "scatter3d", mode = "lines") %>%
  layout(scene = list(
    xaxis = list(title = "x", range = c(-2, 2)),
    yaxis = list(title = "y", range = c(-1, 3)),
    zaxis = list(title = "z", range = c(-1, 3))
  ))

# Render the plot
p

note: this is a rotated trial

1.0.1 Distribution of errors

# plot distribution of error_size
p <- ggplot(omnibus_df, aes(x = error_size,
                            fill = type)) +
  geom_histogram(binwidth = .5, alpha = .6) +
  theme_minimal() +
  theme(text = element_text(size = 11)) +
  scale_fill_manual(values=c("#d40000", "#f9982c")) +
  labs(x = "Error Size (cm)", y = "Count")

p

1.0.2 Distribution of throw angles

# plot distribution of error_size
p <- ggplot(omnibus_df, aes(x = throw_deviation,
                            fill = type)) +
  geom_histogram(binwidth = 1, alpha = .6) +
  theme_minimal() +
  theme(text = element_text(size = 11)) +
  scale_fill_manual(values=c("#f9982c", "#d40000")) +
  labs(x = "Throw Angle (°)", y = "Count")

p

2 Original Experiments

2.0.1 Plot ANGULAR DEVIATIONS (hand angles)

Note: Blues = Acceleration Perturbations

# rest of the exps
data_per_group <- omnibus_df %>%
  filter(exp_label == "original_exps") %>%
  group_by(experiment, test_type, trial_num) %>%
  summarise(
    mean_deviation = mean(throw_deviation),
    ci_deviation = vector_confint(throw_deviation),
    .groups = "drop"
  )

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = trial_num, y = mean_deviation, colour = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Throw Angle (°)"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(-15), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# p <- p +
#   scale_y_continuous(
#     limits = c(-10, 35),
#     breaks = c(0, 15, 30),
#     labels = c(0, 15, 30)
#   ) +
#   scale_x_continuous(
#     limits = c(0, 180),
#     breaks = c(0, 60, 120, 180),
#     labels = c(0, 60, 120, 180)
#   )

# set font size to 11
p <- p +
  theme(text = element_text(size = 11))

# add confidence intervals and data points
p <- p + geom_ribbon(
  aes(
    ymin = mean_deviation - ci_deviation,
    ymax = mean_deviation + ci_deviation,
    fill = experiment
  ),
  colour = NA, alpha = 0.3
) + geom_line()

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)


# # save
# if (save_plots) {
#   ggsave(
#   p,
#   filename = "../plots/paper_figs/sr_30_training.pdf", device = "pdf",
#   height = 4, width = 6
#   )
#   }

ggplotly(p)

# p

2.0.2 Trial sets of interest only

Note: Blues = Acceleration Perturbations

# filter out just the trials of interest
data_per_group <- data_per_group %>%
  filter(
    test_type != "other"
  )
# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
  mutate(dummy_x = rep(1:(nrow(data_per_group) / 6),
    length.out = nrow(data_per_group)
  ))

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = dummy_x, y = mean_deviation, colour = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Throw Angle (°)"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(-15), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# add confidence intervals and data points
for (unique_test_type in unique(data_per_group$test_type)) {
  # get the data for this block
  to_plot_data <- filter(data_per_group, test_type == unique_test_type)

  p <- p + geom_ribbon(
    data = to_plot_data,
    aes(
      ymin = mean_deviation - ci_deviation,
      ymax = mean_deviation + ci_deviation,
      fill = experiment
    ), colour = NA, alpha = 0.3
  ) + geom_line(
    data = to_plot_data
  )
}

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

2.0.3 Plot ERROR SIZE

Note: Blues = Acceleration Perturbations

# original experiments only
data_per_group <- omnibus_df %>%
  filter(exp_label == "original_exps") %>%
  group_by(experiment, test_type, trial_num) %>%
  summarise(
    mean_deviation = mean(error_size),
    ci_deviation = vector_confint(error_size),
    .groups = "drop"
  )

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = trial_num, y = mean_deviation, colour = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Absolute Target Error (cm)"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(-15), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# p <- p +
#   scale_y_continuous(
#     limits = c(-10, 35),
#     breaks = c(0, 15, 30),
#     labels = c(0, 15, 30)
#   ) +
#   scale_x_continuous(
#     limits = c(0, 180),
#     breaks = c(0, 60, 120, 180),
#     labels = c(0, 60, 120, 180)
#   )

# set font size to 11
p <- p +
  theme(text = element_text(size = 11))

# add confidence intervals and data points
p <- p + geom_ribbon(
  aes(
    ymin = mean_deviation - ci_deviation,
    ymax = mean_deviation + ci_deviation,
    fill = experiment
  ),
  colour = NA, alpha = 0.3
) + geom_line()

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)


# # save
# if (save_plots) {
#   ggsave(
#   p,
#   filename = "../plots/paper_figs/sr_30_training.pdf", device = "pdf",
#   height = 4, width = 6
#   )
#   }

ggplotly(p)

# p

visible vs non-visible tilt doesn’t affect the 15-degree rotation condition. But affects all other conditions. So 15-degree rotation

2.0.4 Trial sets of interest only

Note: Blues = Acceleration Perturbations

# filter out just the trials of interest
data_per_group <- data_per_group %>%
  filter(
    test_type != "other"
  )
# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
  mutate(dummy_x = rep(1:(nrow(data_per_group) / 6),
    length.out = nrow(data_per_group)
  ))

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = dummy_x, y = mean_deviation, colour = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Absolute Target Error (cm)"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(-15), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# add confidence intervals and data points
for (unique_test_type in unique(data_per_group$test_type)) {
  # get the data for this block
  to_plot_data <- filter(data_per_group, test_type == unique_test_type)

  p <- p + geom_ribbon(
    data = to_plot_data,
    aes(
      ymin = mean_deviation - ci_deviation,
      ymax = mean_deviation + ci_deviation,
      fill = experiment
    ), colour = NA, alpha = 0.3
  ) + geom_line(
    data = to_plot_data
  )
}

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

3 Animated Surface Follow-up

3.0.1 Plot ANGULAR DEVIATIONS (hand angles)

# isolate animate_surface exp
data_per_group <- omnibus_df %>%
  filter(exp_label == "animate_surface") %>%
  group_by(prior_anim, block_num, trial_num_in_block, trial_num) %>%
  summarise(
    mean_deviation = mean(throw_deviation),
    ci_deviation = vector_confint(throw_deviation)
  )

# order the factors for assigning colour pallets
data_per_group$prior_anim <- factor(
  data_per_group$prior_anim,
  levels = c(
    "none", "half_anim", "full_anim"
  )
)

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = trial_num, y = mean_deviation,
      ymin = mean_deviation - ci_deviation,
      ymax = mean_deviation + ci_deviation
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Throw Angle (°)"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(-15), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# p <- p +
#   scale_y_continuous(
#     limits = c(-10, 35),
#     breaks = c(0, 15, 30),
#     labels = c(0, 15, 30)
#   ) +
#   scale_x_continuous(
#     limits = c(0, 180),
#     breaks = c(0, 60, 120, 180),
#     labels = c(0, 60, 120, 180)
#   )

# set font size to 11
p <- p +
  theme(text = element_text(size = 11))

# repeat for prior_anim == "half", "full" and "wait"
for (unique_prior_anim in unique(data_per_group$prior_anim)) {
  # get the data for this block
  to_plot_data <- filter(data_per_group, prior_anim == unique_prior_anim)
  # loop through the unique blocks in to_plot_data
  for (block in unique(to_plot_data$block_num)) {
    # get the data for this block
    block_data <- filter(to_plot_data, block_num == block)
    # add the data, use the pallete_list to get the colour
    p <- p + geom_ribbon(
      data = block_data,
      aes(fill = prior_anim),
      colour = NA, alpha = 0.3
    ) + geom_line(
      data = block_data,
      aes(colour = prior_anim)
    )
  }
}

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

# # save
# if (save_plots) {
#   ggsave(
#   p,
#   filename = "../plots/paper_figs/sr_30_training.pdf", device = "pdf",
#   height = 4, width = 6
#   )
#   }

ggplotly(p)

# p

3.0.2 Washout trials after half VS full animations

# first, isolate the data
data <- omnibus_df %>%
  filter(
    exp_label == "animate_surface",
    baseline_block == FALSE,
    test_type == "washout_anim"
  )

data_per_ppt <- data %>%
  group_by(ppid, prior_anim, trial_num_in_block) %>%
  summarise(
    ppt_mean_deviation = median(throw_deviation),
    ppt_ci_deviation = vector_confint(throw_deviation),
    n = n()
  )

data_per_group <- data_per_ppt %>%
  group_by(prior_anim, trial_num_in_block) %>%
  summarise(
    mean_deviation = mean(ppt_mean_deviation),
    ci_deviation = vector_confint(ppt_mean_deviation),
    n = sum(n)
  )

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = trial_num_in_block, y = mean_deviation,
      colour = prior_anim, fill = prior_anim
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number in Block",
    y = "Throw Angle (°)"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(-15), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# add data points
p <- p + geom_beeswarm(
  data = data_per_ppt,
  aes(
    y = ppt_mean_deviation,
    colour = prior_anim
  ),
  size = 1, dodge.width = 0.5
) + geom_ribbon(
  aes(
    ymin = mean_deviation - ci_deviation,
    ymax = mean_deviation + ci_deviation
  ),
  colour = NA, alpha = 0.3
) + geom_line()


# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

4 Deprecated (Don’t Run)

4.1 Success manifolds

4.1.1 Without any tilts

# ggplotly(plot_success_manifold_no_tilt())
plot_success_manifold_no_tilt()

4.1.2 With tilt present

ggplotly(plot_success_manifold_tilt())